home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_guile.idb / usr / freeware / share / guile / 1.3 / ice-9 / string-fun.scm.z / string-fun.scm
Encoding:
Text File  |  1999-04-16  |  8.5 KB  |  273 lines
  1. ;;;; string-fun.scm --- string manipulation functions
  2. ;;;;
  3. ;;;;     Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This program is free software; you can redistribute it and/or modify
  6. ;;;; it under the terms of the GNU General Public License as published by
  7. ;;;; the Free Software Foundation; either version 2, or (at your option)
  8. ;;;; any later version.
  9. ;;;; 
  10. ;;;; This program is distributed in the hope that it will be useful,
  11. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;;;; GNU General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU General Public License
  16. ;;;; along with this software; see the file COPYING.  If not, write to
  17. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18. ;;;; Boston, MA 02111-1307 USA
  19. ;;;; 
  20.  
  21. (define-module (ice-9 string-fun))
  22.  
  23. ;;;;
  24. ;;;
  25. ;;; Various string funcitons, particularly those that take
  26. ;;; advantage of the "shared substring" capability.
  27. ;;;
  28.  
  29. ;;; {String Fun: Dividing Strings Into Fields}
  30. ;;; 
  31. ;;; The names of these functions are very regular.
  32. ;;; Here is a grammar of a call to one of these:
  33. ;;;
  34. ;;;   <string-function-invocation>
  35. ;;;   := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>)
  36. ;;;
  37. ;;; <str>    = the string
  38. ;;;
  39. ;;; <ret>    = The continuation.  String functions generally return
  40. ;;;           multiple values by passing them to this procedure.
  41. ;;;
  42. ;;; <action> =    split
  43. ;;;        | separate-fields
  44. ;;;
  45. ;;;        "split" means to divide a string into two parts.
  46. ;;;            <ret> will be called with two arguments.
  47. ;;;
  48. ;;;        "separate-fields" means to divide a string into as many
  49. ;;;            parts as possible.  <ret> will be called with
  50. ;;;            however many fields are found.
  51. ;;;
  52. ;;; <seperator-disposition> =       before
  53. ;;;                | after
  54. ;;;                | discarding
  55. ;;;
  56. ;;;        "before" means to leave the seperator attached to
  57. ;;;            the beginning of the field to its right.
  58. ;;;        "after" means to leave the seperator attached to
  59. ;;;            the end of the field to its left.
  60. ;;;        "discarding" means to discard seperators.
  61. ;;;
  62. ;;;        Other dispositions might be handy.  For example, "isolate"
  63. ;;;        could mean to treat the separator as a field unto itself.
  64. ;;;
  65. ;;; <seperator-determination> =      char
  66. ;;;                | predicate
  67. ;;;
  68. ;;;        "char" means to use a particular character as field seperator.
  69. ;;;        "predicate" means to check each character using a particular predicate.
  70. ;;;        
  71. ;;;        Other determinations might be handy.  For example, "character-set-member".
  72. ;;;
  73. ;;; <seperator-param> = A parameter that completes the meaning of the determinations.
  74. ;;;            For example, if the determination is "char", then this parameter
  75. ;;;            says which character.  If it is "predicate", the parameter is the
  76. ;;;            predicate.
  77. ;;;
  78. ;;;
  79. ;;; For example:
  80. ;;;
  81. ;;;        (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list)
  82. ;;;        => ("foo" " bar" " baz" " " " bat")
  83. ;;;
  84. ;;;        (split-after-char #\- 'an-example-of-split list)
  85. ;;;        => ("an-" "example-of-split")
  86. ;;;
  87. ;;; As an alternative to using a determination "predicate", or to trying to do anything
  88. ;;; complicated with these functions, consider using regular expressions.
  89. ;;;
  90.  
  91. (define-public (split-after-char char str ret)
  92.   (let ((end (cond
  93.           ((string-index str char) => 1+)
  94.           (else (string-length str)))))
  95.     (ret (make-shared-substring str 0 end)
  96.      (make-shared-substring str end))))
  97.  
  98. (define-public (split-before-char char str ret)
  99.   (let ((end (or (string-index str char)
  100.          (string-length str))))
  101.     (ret (make-shared-substring str 0 end)
  102.      (make-shared-substring str end))))
  103.  
  104. (define-public (split-discarding-char char str ret)
  105.   (let ((end (string-index str char)))
  106.     (if (not end)
  107.     (ret str "")
  108.     (ret (make-shared-substring str 0 end)
  109.          (make-shared-substring str (1+ end))))))
  110.  
  111. (define-public (split-after-char-last char str ret)
  112.   (let ((end (cond
  113.           ((string-rindex str char) => 1+)
  114.           (else 0))))
  115.     (ret (make-shared-substring str 0 end)
  116.      (make-shared-substring str end))))
  117.  
  118. (define-public (split-before-char-last char str ret)
  119.   (let ((end (or (string-rindex str char) 0)))
  120.     (ret (make-shared-substring str 0 end)
  121.      (make-shared-substring str end))))
  122.  
  123. (define-public (split-discarding-char-last char str ret)
  124.   (let ((end (string-rindex str char)))
  125.     (if (not end)
  126.     (ret str "")
  127.     (ret (make-shared-substring str 0 end)
  128.          (make-shared-substring str (1+ end))))))
  129.  
  130. (define (split-before-predicate pred str ret)
  131.   (let loop ((n 0))
  132.     (cond
  133.      ((= n (string-length str))        (ret str ""))
  134.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  135.      (else                (ret (make-shared-substring str 0 n)
  136.                          (make-shared-substring str n))))))
  137. (define (split-after-predicate pred str ret)
  138.   (let loop ((n 0))
  139.     (cond
  140.      ((= n (string-length str))        (ret str ""))
  141.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  142.      (else                (ret (make-shared-substring str 0 (1+ n))
  143.                          (make-shared-substring str (1+ n)))))))
  144.  
  145. (define (split-discarding-predicate pred str ret)
  146.   (let loop ((n 0))
  147.     (cond
  148.      ((= n (string-length str))        (ret str ""))
  149.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  150.      (else                (ret (make-shared-substring str 0 n)
  151.                          (make-shared-substring str (1+ n)))))))
  152.  
  153. (define-public (separate-fields-discarding-char ch str ret)
  154.   (let loop ((fields '())
  155.          (str str))
  156.     (cond
  157.      ((string-rindex str ch)
  158.       => (lambda (w) (loop (cons (make-shared-substring str (+ 1 w)) fields)
  159.                (make-shared-substring str 0 w))))
  160.      (else (apply ret str fields)))))
  161.  
  162. (define-public (separate-fields-after-char ch str ret)
  163.   (reverse
  164.    (let loop ((fields '())
  165.              (str str))
  166.      (cond
  167.       ((string-index str ch)
  168.        => (lambda (w) (loop (cons (make-shared-substring str 0 (+ 1 w)) fields)
  169.                            (make-shared-substring str (+ 1 w)))))
  170.       (else (apply ret str fields))))))
  171.  
  172. (define-public (separate-fields-before-char ch str ret)
  173.   (let loop ((fields '())
  174.          (str str))
  175.     (cond
  176.      ((string-rindex str ch)
  177.       => (lambda (w) (loop (cons (make-shared-substring str w) fields)
  178.                  (make-shared-substring str 0 w))))
  179.      (else (apply ret str fields)))))
  180.  
  181.  
  182. ;;; {String Fun: String Prefix Predicates}
  183. ;;;
  184. ;;; Very simple:
  185. ;;;
  186. ;;; (define-public ((string-prefix-predicate pred?) prefix str)
  187. ;;;  (and (<= (string-length prefix) (string-length str))
  188. ;;;      (pred? prefix (make-shared-substring str 0 (string-length prefix)))))
  189. ;;;
  190. ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
  191. ;;;
  192.  
  193. (define-public ((string-prefix-predicate pred?) prefix str)
  194.   (and (<= (string-length prefix) (string-length str))
  195.        (pred? prefix (make-shared-substring str 0 (string-length prefix)))))
  196.  
  197. (define-public string-prefix=? (string-prefix-predicate string=?))
  198.  
  199.  
  200. ;;; {String Fun: Strippers}
  201. ;;;
  202. ;;; <stripper> = sans-<removable-part>
  203. ;;;
  204. ;;; <removable-part> =       surrounding-whitespace
  205. ;;;            | trailing-whitespace
  206. ;;;            | leading-whitespace
  207. ;;;            | final-newline
  208. ;;;
  209.  
  210. (define-public (sans-surrounding-whitespace s)
  211.   (let ((st 0)
  212.     (end (string-length s)))
  213.     (while (and (< st (string-length s))
  214.         (char-whitespace? (string-ref s st)))
  215.        (set! st (1+ st)))
  216.     (while (and (< 0 end)
  217.         (char-whitespace? (string-ref s (1- end))))
  218.        (set! end (1- end)))
  219.     (if (< end st)
  220.     ""
  221.     (make-shared-substring s st end))))
  222.  
  223. (define-public (sans-trailing-whitespace s)
  224.   (let ((st 0)
  225.     (end (string-length s)))
  226.     (while (and (< 0 end)
  227.         (char-whitespace? (string-ref s (1- end))))
  228.        (set! end (1- end)))
  229.     (if (< end st)
  230.     ""
  231.     (make-shared-substring s st end))))
  232.  
  233. (define-public (sans-leading-whitespace s)
  234.   (let ((st 0)
  235.     (end (string-length s)))
  236.     (while (and (< st (string-length s))
  237.         (char-whitespace? (string-ref s st)))
  238.        (set! st (1+ st)))
  239.     (if (< end st)
  240.     ""
  241.     (make-shared-substring s st end))))
  242.  
  243. (define-public (sans-final-newline str)
  244.   (cond
  245.    ((= 0 (string-length str))
  246.     str)
  247.  
  248.    ((char=? #\nl (string-ref str (1- (string-length str))))
  249.     (make-shared-substring str 0 (1- (string-length str))))
  250.  
  251.    (else str)))
  252.  
  253. ;;; {String Fun: has-trailing-newline?}
  254. ;;;
  255.  
  256. (define-public (has-trailing-newline? str)
  257.   (and (< 0 (string-length str))
  258.        (char=? #\nl (string-ref str (1- (string-length str))))))
  259.  
  260.  
  261.  
  262. ;;; {String Fun: with-regexp-parts}
  263.  
  264. ;;; This relies on the older, hairier regexp interface, which we don't
  265. ;;; particularly want to implement, and it's not used anywhere, so
  266. ;;; we're just going to drop it for now.
  267. ;;; (define-public (with-regexp-parts regexp fields str return fail)
  268. ;;;   (let ((parts (regexec regexp str fields)))
  269. ;;;     (if (number? parts)
  270. ;;;         (fail parts)
  271. ;;;         (apply return parts))))
  272.  
  273.